home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 24 / CU Amiga Magazine's Super CD-ROM 24 (1998)(EMAP Images)(GB)(Track 1 of 2)[!][issue 1998-07].iso / CUCD / Programming / SWI / source / boot / messages.pl < prev    next >
Encoding:
Text File  |  1997-11-04  |  4.2 KB  |  150 lines
  1. /*  $Id: messages.pl,v 1.2 1997/11/04 10:38:21 jan Exp $
  2.  
  3.     Part of SWI-Prolog
  4.     Designed and implemented by Jan Wielemaker
  5.     E-mail: jan@swi.psy.uva.nl
  6.  
  7.     Copyright (C) 1997 University of Amsterdam. All rights reserved.
  8. */
  9.  
  10. :- module($messages,
  11.       [ print_message/2        % +Kind, +Term
  12.       ]).
  13.  
  14. message(Term) -->
  15.     {var(Term)}, !,
  16.     [ 'Unknown exception term: ~p'-[Term] ].
  17. message(error(ISO, SWI)) -->
  18.     swi_context(SWI),
  19.     term_message(ISO),
  20.     swi_extra(SWI).
  21. message(Term) -->
  22.     [ 'Unknown exception term: ~p'-[Term] ].
  23.  
  24. term_message(Term) -->
  25.     {var(Term)}, !,
  26.     [ 'Unknown error term: ~p'-[Term] ].
  27. term_message(Term) -->
  28.     iso_message(Term).
  29. term_message(Term) -->
  30.     swi_message(Term).
  31. term_message(Term) -->
  32.     [ 'Unknown error term: ~p'-[Term] ].
  33.  
  34. iso_message(type_error(evaluable, Actual)) -->
  35.     [ 'Arithmetic: `~p'' is not a function'-[Actual] ].
  36. iso_message(type_error(Expected, Actual)) -->
  37.     [ 'Type error: `~w'' expected, found `~p'''-[Expected, Actual] ].
  38. iso_message(domain_error(Domain, Actual)) -->
  39.     [ 'Domain error: `~w'' expected, found `~p'''-[Domain, Actual] ].
  40. iso_message(instantiation_error) -->
  41.     [ 'Arguments are not sufficiently instantiated' ].
  42. iso_message(representation_error(What)) -->
  43.     [ 'Cannot represent due to `~w'''-[What] ].
  44. iso_message(permission_error(Action, Type, Object)) -->
  45.     [ 'No permission to ~w ~w `~p'''-[Action, Type, Object] ].
  46. iso_message(evaluation_error(Which)) -->
  47.     [ 'Arithmetic: evaluation error: `~p'''-[Which] ].
  48. iso_message(existence_error(procedure, Proc)) -->
  49.     [ 'Undefined procedure: ~p'-[Proc] ],
  50.     { dwim_predicates(Proc, Dwims) },
  51.     (   {Dwims \== []}
  52.     ->  [nl, '    However, there are definitions for:', nl],
  53.         dwim_message(Dwims)
  54.     ;   []
  55.     ).
  56. iso_message(existence_error(Type, Object)) -->
  57.     [ '~w `~p'' does not exist'-[Type, Object] ].
  58.  
  59. dwim_predicates(Module:Name/_Arity, Dwims) :- !,
  60.     findall(Dwim, dwim_predicate(Module:Name, Dwim), Dwims).
  61. dwim_predicates(Name/_Arity, Dwims) :-
  62.     findall(Dwim, dwim_predicate(user:Name, Dwim), Dwims).
  63.  
  64. dwim_message([]) --> [].
  65. dwim_message([user:Head|T]) --> !,
  66.     {functor(Head, Name, Arity)},
  67.     [ '~t~8|~w/~d'-[Name, Arity], nl ],
  68.     dwim_message(T).
  69. dwim_message([Module:Head|T]) --> !,
  70.     {functor(Head, Name, Arity)},
  71.     [ '~t~8|~w:~w/~d'-[Module, Name, Arity], nl],
  72.     dwim_message(T).
  73. dwim_message([Head|T]) -->
  74.     {functor(Head, Name, Arity)},
  75.     [ '~t~8|~w/~d'-[Name, Arity], nl],
  76.     dwim_message(T).
  77.  
  78.  
  79. swi_message(io_error(Op, Stream)) -->
  80.     [ 'I/O error in ~w on stream ~w'-[Op, Stream] ].
  81. swi_message(shell(execute, Cmd)) -->
  82.     [ 'Could not execute `~w'''-[Cmd] ].
  83. swi_message(shell(signal(Sig), Cmd)) -->
  84.     [ 'Caught signal ~d on `~w'''-[Sig, Cmd] ].
  85.  
  86.  
  87. swi_context(context(Name/Arity, _Msg)) -->
  88.     { nonvar(Name)
  89.     }, !,
  90.     [ '~q/~w: '-[Name, Arity] ].
  91. swi_context(_) -->
  92.     [].
  93.  
  94. swi_extra(context(_, Msg)) -->
  95.     { atomic(Msg),
  96.       Msg \== ''
  97.     }, !,
  98.     [ ' (~w)'-[Msg] ].
  99. swi_extra(_) -->
  100.     [].
  101.  
  102. %    print_message(+Kind, +Term)
  103. %
  104. %    Print an error message using a term as generated by the exception
  105. %    system.
  106.  
  107.  
  108. print_message(Level, Term) :-
  109.     message_to_string(Term, Str),
  110.     (   current_predicate(_, user:message_hook(_,_,_)),
  111.         user:message_hook(Term, Level, Str)
  112.     ->  true
  113.     ;   source_location(File, Line)
  114.     ->  format(user_error, '[WARNING: (~w:~d):~n~t~8|~w]~n',
  115.            [File, Line, Str])
  116.     ;   format(user_error, '[WARNING: ~w]~n', [Str])
  117.     ).
  118.  
  119.  
  120. %    message_to_string(+Term, -String)
  121. %
  122. %    Translate an error term into a string
  123.  
  124. message_to_string(Term, Str) :-
  125.         message(Term, Actions, []), !,
  126.         actions_to_format(Actions, Fmt, Args),
  127.         sformat(Str, Fmt, Args).
  128.  
  129. actions_to_format([], '', []) :- !.
  130. actions_to_format([nl], '', []) :- !.
  131. actions_to_format([Term, nl], Fmt, Args) :- !,
  132.     actions_to_format([Term], Fmt, Args).
  133. actions_to_format([nl|T], Fmt, Args) :- !,
  134.     actions_to_format(T, Fmt0, Args),
  135.     concat('~n', Fmt0, Fmt).
  136. actions_to_format([Fmt0-Args0|Tail], Fmt, Args) :- !,
  137.         actions_to_format(Tail, Fmt1, Args1),
  138.         concat(Fmt0, Fmt1, Fmt),
  139.         append(Args0, Args1, Args).
  140. actions_to_format([Term|Tail], Fmt, Args) :-
  141.     atomic(Term), !,
  142.         actions_to_format(Tail, Fmt1, Args),
  143.     concat(Term, Fmt1, Fmt).
  144. actions_to_format([Term|Tail], Fmt, Args) :-
  145.         actions_to_format(Tail, Fmt1, Args1),
  146.         concat('~w', Fmt1, Fmt),
  147.         append([Term], Args1, Args).
  148.  
  149.     
  150.